;;############################################################################
;; datavis3.lsp
;; Copyright (c) 1999-2000 by Forrest W. Young
;; code to visualize 1-way & n-way frequency array data (category data)
;; and crosstabs (multivariate mixed category/numeric data)
;;############################################################################


(defmeth mv-data-object-proto :visualize-freq-array ()
  (let* ((sizes (send self :array-dimensions)))
    (if (or (= 1 (length sizes)) (= 1 (first sizes)) (= 1 (second  sizes)))
        (send self :visualize-1way-freq-array);1way
        (send self :visualize-nway-freq-array))))
                     
(defmeth mv-data-object-proto :visualize-1way-freq-array ()
  (let* ((freq-array-list (combine (send self :active-freq-array)))
         (array-labels (send self :active-array-labels))
         (num-levels (send self :array-dimensions))
         (num-apparent-ways (length num-levels))
         (basis 
          (if (= 1 num-apparent-ways) '(0)
             (if (= 1 (first num-levels)) '(1 0) '(0 1))))
         (varnames (send self :active-array-variables))
         (way-labels (select varnames basis))
         (level-labels (select array-labels basis))
         (num-levels (select num-levels basis))
         (bg (bar-graph 
              freq-array-list (list (first num-levels))
              :connect nil
              :stacked nil
             ;:color-values (- freq-array-list (mean freq-array-list))
              :color-values (/ (- freq-array-list (mean freq-array-list)) 
                                (sqrt (mean freq-array-list)));pv
              :way-labels (list (first way-labels))
              :level-labels (list (first level-labels))
              :show  nil))
      ;   (mp (mosaic-plot 
      ;        freq-array-list (list (first num-levels))
      ;        :connect nil
      ;        :stacked nil
      ;        :color-values (- freq-array-list (mean freq-array-list))
      ;        :way-labels (list (first way-labels))
      ;        :level-labels (list (first level-labels))
      ;        :show  nil))
         (dw (datasheet
              (data "nada"
                    :iconify nil
                    :watcher nil
                    :freq t
                    :variables (list "Frequency")
                    :labels (first level-labels)
                    :data freq-array-list)
              :title "Frequency Table"
              :freq t
              :ndecimals 0 
              :shrink-wrap t
              :dont-adjust-sizeloc t
              :ncolumns 8
              :container *active-container* 
              :show nil))
         (sp (spread-plot (matrix '(1 2) (list bg dw))
                          :rel-widths '( 1 .4)))
         )
    (send dw :dash-buttons :pop nil :lock nil :max nil :refresh nil :save nil)
    (send sp :show-spreadplot)
    (send sp :title "Frequency Data SpreadPlot")
    (send *watcher* :close)))


(defmeth mv-data-object-proto :visualize-nway-crosstabs-array ()
  (if (equal 1 (length (send self :active-variables '(category))))
      (send self :visualize-1way-freq-array)
      (send self :visualize-nway-freq-array t)))

  
(defmeth mv-data-object-proto :visualize-nway-freq-array (&optional crosstab)
  (send *watcher* :write-text (format nil "Creating Visualization"))
  (SEND *WORKMAP* :FREEZE-ALL-ICONS T)
  (let* ((freq-array (send self :active-freq-array))
         (data-array (send self :active-data-array))
         (array-labels (send self :active-array-labels))
         (varnames (send self :active-array-variables))
;fwy crosstab

         (numvarnames (send self :active-variables '(numeric ordinal)))
         (numordtypes (send self :active-types '(numeric ordinal)))
         (numeric-data (column-list (send self :active-data-matrix '(numeric ordinal))))
         (n-numordvar (length numvarnames))
         (numordvar-indices (iseq n-numordvar))
         (nclasses (send self :array-dimensions))
         (selection '(0 1))
         (nways (length nclasses))
         (basis (if (> nways 1) selection '(0)))
         (num-levels (select nclasses basis))
         (way-labels (select varnames basis))
         (freq-info (list freq-array array-labels))
         (cellfreqs (combine freq-array))
         (one-row? (= 1 (first num-levels)))
         (one-col? (= 1 (second num-levels)))
         (one-way? (or one-row? one-col?))
         (summed-freqs-mat (send self :sum-freq-arrays basis crosstab))
;fwy crosstab
         (cell-data-matrix (if (listp summed-freqs-mat)
                               (second summed-freqs-mat)
                               nil))
;fwy crosstab
         (summed-freqs-mat (if (listp summed-freqs-mat)
                               (first summed-freqs-mat)
                               summed-freqs-mat))
         (expected-freqs-mat 
          (first (send self :expected-values summed-freqs-mat)))
        ;(color-mat (- summed-freqs-mat expected-freqs-mat))
         (color-mat (/ (- summed-freqs-mat expected-freqs-mat)
                                         (sqrt expected-freqs-mat)));pv
         (summed-freqs-list (combine summed-freqs-mat))
         (classes array-labels)
         (level-labels (select classes basis))
         (nclasses (mapcar #'length classes))
         (container *active-container*)
         (result (send *watcher* :write-text 
                         (format nil "Creating Visualization - Making Bar Graph")))
         (bg (bar-graph 
              summed-freqs-list num-levels
              :connect (not one-way?)
              :stacked (not one-way?)
              :color-values (combine color-mat)
              :way-labels way-labels
              :level-labels level-labels
              :standardize nil ;PV
              :show  nil))
         (result (send *watcher* :write-text 
                       (format nil "Creating SpreadPlot - Making Mosaic"))) 
         (mp (unless one-way?
                     (mosaic-plot summed-freqs-list num-levels 
                                  :connect-button (not one-way?)
                                  :color-values (combine color-mat)
                                  :way-labels way-labels 
                                  :level-labels level-labels
                                  :standardize nil ;PV
                                  :show nil)))
         (result (send *watcher* :write-text 
                       (format nil "Creating Visualization - Making Data Object")))
;XXXXXXXXXXXXXXX
         (result (send self :make-spreadplot-freq-array
                       level-labels num-levels summed-freqs-list))
;fwy crosstab
        (splot-dob (data "nemo"
               :iconify nil
               :watcher nil
               :freq t
               :all-types-in-data-array t
               :variables (second result) 
               :labels    (third  result) 
               :data (combine 
                      (transpose 
                       (matrix (list (length (second result)) 
                                     (length (third result)))
                               (first result))))))
         (result (send *watcher* :write-text 
                       (format nil "Creating Visualization - Making DataSheet")))
         (dw (datasheet splot-dob              
              :title "Frequency Table"
              :freq t
              :ndecimals 0 
              :shrink-wrap nil
              :dont-adjust-sizeloc t
              :ncolumns 6 
              :show t
              :container *spreadplot-container*))
         (way-list (name-list varnames :show nil :title "Change Plots" :help-only t))

         (junk (send way-list :size 100 (* (length varnames) 30)))
         (junk (defmeth way-list :update-plotcell (i j args)))
         (dw-shrink-sizes (send dw :shrink-wrap))
         (sp)
         (rw)
         (numvar-list)
         (stats-list)
         (dw-splot-sizes)
         (mvdob self)
         
         )
    (defmeth dw :plot-help ()
      (plot-help-window (strcat "Help for CrossTabs Frequency Table"))
      (when crosstab 
           (paste-plot-help (format nil "This window serves two purposes:~%  1: It is a crosstabulation table of your data;~%  2: It is a control panel for the visualization.~2%   CROSSTAB: ")))
      (paste-plot-help (format nil "This window shows a crosstabulation of the category variables that are selected in the list of category variables. There is a cell in the table for every combination of the several levels for the several selected variables. The number in each cell is the frequency of each combination. Up to four category variables may be used to form the crosstab. The first two category variables are used to form the initial crosstabulation.~2%"))
      (when crosstab
            (paste-plot-help (format nil "   CONTROL PANEL: This table is a control panel for the visualization. By clicking on cells of the table you can change what is shown in other panes of the visualization. Specifically, when you click on a cell, the information on the numeric variables for the individuals included in the cell's classification is used to construct the statistical summary report (and, in a future release, to construct graphics).")))
      (show-plot-help))

    

    (send (first (send dw :overlays)) :remove-button ':max)
    (send (first (send dw :overlays)) :remove-button ':lock)
    ;(send (first (send dw :overlays)) :remove-button ':save)
    ;(send (first (send dw :overlays)) :install-button ':pop)

    (when crosstab
         ; (setf bp (boxplot numeric-data :variable-labels varnames :equate t))
          (setf rw (summary :moments nil :quartiles nil :show nil
                            :pop-out nil :container *spreadplot-container* 
                            :free nil :shrink-wrap nil))
          (defmeth rw :do-click (x y m1 m2) )
          (setf numvar-list (name-list numvarnames
                              :show nil :title "Change Plots" :help-only t))
          (setf stats-list (list "Information" "Data Listing" "Moments" "Quantiles" 
                 "Corr/Cov"));"Box/Diamond" "Histo/Freq" "N-Prob/Quant" "Point Plots"
          (setf stats-list (name-list stats-list :show nil :title "Show Stats" :help-only t))
          )
    (send *watcher* :write-text 
          (format nil "Creating Visualization - Making SpreadPlot"))
    
    (setf sp  
          (if crosstab
; ultimate design: have plots of selected numeric variables, 
; plot shows dash cell's data for selected numeric variables
; type of plot determined by selected plot-types in stats-list
; mosaic plot replced by side-by-side boxplot for any number of numeric vars
; bargraph replaced by histofreq when 1 numvar, scat 2; spin 3; scatmat > 3
               (spread-plot 
                (matrix '(6 3) 
; ultimately next line would be 
;                       way-list    dw  (list boxplot mp)
                  (list way-list    dw  mp 
                        nil         nil nil
                        numvar-list rw  nil 
; ultimately next line would be
;                       nil         nil (list histofreq scat spin scatmat bg)
                        nil         nil bg
                        stats-list  nil nil 
                        nil         nil nil))
                :rel-widths   '(1.25 6 3.25) ; '(1.5 5.5 3.75)
                :rel-heights  '(1 1 1 1 1 1)   
                :span-right #2A((1 1 1) (0 0 0) (1 1 0) (0 0 1) (1 0 0) (0 0 0))
                :span-down  #2A((2 2 3) (0 0 0) (2 4 0) (0 0 3) (2 0 0) (0 0 0))
                :show nil
                )  
               (spread-plot (matrix '(2 3) (list mp bg way-list dw nil nil))
                            :span-right #2A((1 1 1) (3 0 0))
                           :rel-widths (list 1 1 .4)
                            :rel-heights (list 1 .5)
                           :show nil)
              ; (spread-plot (matrix '(2 3) (list mp bg way-list dw nil nil))
              ;              :span-right #2A((1 1 1) (3 0 0))
              ;             :rel-widths (list 1 1 .4)
              ;             :show nil)
                   ))
    
    (when crosstab
          (defmeth sp :spreadplot-help ()
            (plot-help-window (strcat "SpreadPlot Help"))
            (paste-plot-help (format nil "This is the Crosstabulation SpreadPlot. It is used for Multivariate Data which have a mix of numeric and category variables. In this SpreadPlot the windows-panes are linked by the categories of the category variables. ~2%The CATEGORY VARIABLE LISTING window, which is in the upper left corner, lets you choose which category variables are used to construct the CROSSTABULATION TABLE shown in the upper middle window-pane of the spreadplot. This crosstabulation is visualized in the two graphics at the right.~2%You can click on a cell of the CROSSTABULATION TABLE to see information about the numeric variables selected in the NUMERIC VARIABLE LISTING window-pane at the middle left of the spreadplot.The information you see is only for the subset of individuals included in the cell's crosstabulation. Finally, the information you see is determined by the selection in the bottom left window pane."))
            (show-plot-help)))

    (when (not crosstab)
          (defmeth sp :spreadplot-help ()
            (plot-help-window (strcat "SpreadPlot Help"))
            (paste-plot-help (format nil "This is the Classification Data SpreadPlot. It is used for data which have a only category variables. In this SpreadPlot the windows-panes are linked by the categories of the category variables. ~2%The CATEGORY VARIABLE LISTING window, which is in the upper right corner, lets you choose which category variables are used to construct the CROSSTABULATION TABLE shown in the lower window-pane of the spreadplot. These variables are also used to form the plots shown in the upper half of the spreadplot"))
            (show-plot-help)))

    (send splot-dob :data-array cell-data-matrix)
    (when crosstab
         (defmeth dw :do-click (x y m1 m2) 
           (let ((rw-size (send rw :size)))
             (send self :do-control-panel-click x y m1 m2 mvdob)
             (apply #'send rw :size rw-size)
             )))
    (send self :add-vnfa-varlist-features way-list nways sp)
    
    (when crosstab
          (send self :add-crosstab-slots sp)
          
          (defmeth sp :update-spreadplot (i j &rest args)
            (cond
              ((and (= i 9) (= j 0)) ; from numeric variable list
               (send self :active-numord-vars (first args))
               (send self :active-numord-vars-indices (third args))
               (send self :active-numord-types (second args)))
              ((and (= i 9) (= j 1)) ; from stats-list
               (send self :active-stats (first args)))
              (t                     ; from categroy variable list
                                     (apply #'call-next-method i j args))))
          
          (send sp :n-numordvar n-numordvar)
          (send sp :active-numord-vars-indices numordvar-indices)
          (send self :add-crosstab-methods 
                numvar-list numordtypes stats-list sp)
          (send sp :active-numord-vars numvarnames)
          (send sp :active-numord-types numordtypes)
          (send sp :active-stats '(2 3 4)))

    (let* ((dw-shrink-sizes (send dw :shrink-wrap))
           (dw-window-sizes (mapcar #'max dw-shrink-sizes (send dw :size))))
      (if (/= (sum (- dw-window-sizes (send dw :size))) 0)
          (apply #'send dw :size dw-window-sizes)))
    (send self :make-nway-freq-array-plotcell-methods 
          mp bg dw mvdob nclasses varnames classes crosstab)
    (send *watcher* :write-text 
          (format nil "Creating SpreadPlot~%Creating Links")) 
    (send dw :add-slot 'n-active-ways)
    (defmeth dw :n-active-ways (&optional (val nil set))
      (if set (setf (slot-value 'n-active-ways) val))
      (slot-value 'n-active-ways))
    (setf dw-splot-sizes (select (send sp :sizes) (if crosstab 2 3)))
    (send way-list :has-v-scroll nil)
    (send way-list :has-h-scroll nil)
    (send sp :title (format nil "Category Data SpreadPlot"))
    (send sp :show-spreadplot)
    (when crosstab 
          (send rw :pop-out-on-show nil)
          (send rw :has-v-scroll t)
          (send rw :has-h-scroll t))
    (send sp :resize)
    
    (send *watcher* :hide-window)
    (SEND *WORKMAP* :FREEZE-ALL-ICONS nil)
   ; (send bp :front-window)
    (send way-list :point-selected '(0 1) t)
    (when crosstab
          (send numvar-list :point-selected (iseq n-numordvar) t)
          (send stats-list :point-selected '(2 3 4) t))
    sp))


;ALSO USED BY CROSSTABS
(defmeth mv-data-object-proto :make-nway-freq-array-plotcell-methods 
              (mp bg dw mvdob nclasses varnames classes crosstab)

  (defmeth mp :update-plotcell (i j args)
    (when (and (= i 0) (= j 2))
          (let* ((selection (first args))
                 (double-click (second args))
                 (num-levels (select nclasses selection))
                 (n-ways (length num-levels))
                 (way-labels (select varnames selection))
                 (summed-freqs-array (send mvdob :sum-freq-arrays selection crosstab))
                 (cell-data-matrix (if (listp summed-freqs-array)
                                         (SECOND summed-freqs-array)
                                         nil))
                 (summed-freqs-array (if (listp summed-freqs-array)
                                       (FIRST summed-freqs-array)
                                       summed-freqs-array))
                 (expected-freqs-array 
                  (first (send mvdob :expected-values summed-freqs-array)))
                 (color-list (combine (/ (- summed-freqs-array expected-freqs-array)
                                         (sqrt expected-freqs-array))));Pv
                ; (color-list (combine (- summed-freqs-array expected-freqs-array)))
                 (level-labels (select classes selection))
                 (summed-freqs-list (combine summed-freqs-array))
                 )
            (send self :new-plot summed-freqs-list num-levels
                  :color-values color-list
                  :level-labels level-labels
                  :way-labels way-labels
                  :standardize nil) ;PV
            (send (send mp :spreadplot-object) 
                  :update-spreadplot 0 0 
                  (send self :ways)  ;0
                  num-levels         ;1 
                  (send self :cells) ;2 
                  (send self :tick-mark-labels) ;3 
                  way-labels         ;4
                  summed-freqs-list  ;5
                  color-list         ;6
                  level-labels       ;7
                  cell-data-matrix   ;8
                  ))))

  (defmeth bg :update-plotcell (i j args)
    (when (and (= i 0) (= j 0))
          (let* ((num-levels (select args 1))
                 (way-labels (select args 4))
                 (summed-freqs-list (select args 5))
                 (color-list (select args 6))
                 (level-labels (select args 7)))
            (send self :new-plot 
                  summed-freqs-list 
                  num-levels
                  :stacked t
                  :connected t
                  :color-values color-list
                  :level-labels level-labels
                  :way-labels way-labels
                  :standardize nil))));PV

  (defmeth dw :update-plotcell (i j args)
    (when (and (= i 0) (= j 0))
          (let* ((nways (first args))
                 (nlevels (second args))
                 (freq-list (third args))
                 (colrow-labels (fourth args))
                 (way-labels (fifth args))
                 (cell-data-matrix (ninth args))
                 (dash-data) (dash-array) (dash-matrix-list) (dash-matrix)
                 (dash-variables (first colrow-labels))
                 (dash-labels (second colrow-labels)))
            (send self :n-active-ways nways)
            (cond 
              ((= nways 1) 
               (setf dash-labels way-labels)
               (setf dash-data freq-list)
               (setf dash-matrix (matrix (list 1 (first nlevels)) dash-data))
               )
              ((= nways 2) 
               (setf dash-matrix (matrix nlevels freq-list))
               )
              ((= nways 3)
               (setf dash-array (make-array nlevels :initial-contents freq-list))
               (setf dash-matrix-list (array-list dash-array (list 1 2)))
               (setf dash-matrix (apply #'bind-columns dash-matrix-list))
               )
              ((= nways 4)
               (setf dash-array (make-array nlevels :initial-contents freq-list))
               (setf dash-matrix-list (array-list dash-array (list 2 3)))
               (setf dash-matrix-list (mapcar #'transpose dash-matrix-list))
               (setf dash-matrix
                     (apply #'bind-rows 
                            (mapcar #'(lambda (i)
                                        (apply #'bind-columns 
                                               (select dash-matrix-list 
                                                       (+ (iseq (first nlevels)) 
                                                          (* (first nlevels) i)))))
                                    (iseq (second nlevels)))))
               
               ))
            (setf dash-data (combine (transpose dash-matrix)))
            (send (send self :spreadplot-object) :update-spreadplot 1 1 
                  dash-variables dash-labels dash-matrix nways)
            (when (= nways 2)
                  (setf dash-matrix (transpose dash-matrix)));dont change
            (setf result (send mvdob :make-bordered-freq-datalist
                               dash-labels dash-variables dash-matrix))

            (let* ((this-data (data "Nemo"
                                    :iconify nil
                                    :watcher nil
                                    :freq t
                                    :all-types-in-data-array t
                                    :variables (second result) ;dash-variables
                                    :labels (first result) ;dash-labels
                                    :data (third result))) ;dash-data
                   (dash (datasheet this-data
                          :title "Frequency Table"
                          :window dw
                          :ndecimals 0 
                          :ncolumns 6
                          :shrink-wrap nil
                          :dont-adjust-sizeloc t
                          :location (send dw :location)
                          :size (send dw :size)))
                   (dash-shrink-sizes (send dash :shrink-wrap))
                   (dash-window-sizes (mapcar #'max dash-shrink-sizes (send dash :size))))
              (send dash :redraw);show-window
              (send this-data :data-array cell-data-matrix)
              ))))
     );end make-nway-freq-array-plotcell-methods 

